perm filename PX[NEW,LCS] blob
sn#150846 filedate 1975-03-17 generic text, type T, neo UTF8
00100 TITLE SLOOP
00200 ENTRY RNOTE,DRWNT,RDRAW,SLOOP
00300 EXTERNAL PTR,XRN,STF,.COMM.,CLEFS,AMOD,LINES,ALF
00400 DEFINE FIXX(N)
00500 < JUMPGE N,.+5
00600 MOVNS N
00700 FIX N,233000
00800 MOVNS N
00900 CAIA
01000 FIX N,233000 > ; TO FIX IT LIKE 'IFIX' DOES.
01100
01200 RB←15↔RX←14↔RA←13↔R←12↔KK←11↔L←10↔RW←7↔RZ←6
01300 SLOOP: 0
01400 MOVE RB,.COMM.+=18 ;RB=RX/71.
01500 FDVR RB,[=71.0]
01600 SETZ KK ;DO 81 K=0,71
01700 SLR81: MOVE RA,KK
01800 TLC RA,232000
01900 FADR RA,RA
02000 FMPR RA,RB
02100 FADR RA,.COMM.+4 ;81 SLURX(K+1)=RB*(K)+R3
02200 MOVEI 1,SLR
02300 ADDI 1,(KK)
02400 MOVEM RA,(1)
02500 CAIGE KK,=71
02600 AOJA KK,SLR81
02700 MOVE RA,.COMM.+=8 ;RA=R7*RST7
02800 FMPR RA,.COMM.+=17
02900 MOVE 1,.COMM.+=10 ;41 IF(R9.EQ.0)R9=RZZ
03000 JUMPN 1,SLR41
03100 MOVE 1,[=2.8]
03200 MOVEM 1,.COMM.+=10
03300 SLR41: MOVE R,.COMM.+2 ;R=R+RA CENTR IS R
03400 FADR R,RA
03500 SETZ L ;L=0
03600 MOVE KK,[=36.0] ;DO 40 K=36,1,-1
03700 SLR40: AOJ L ;L=L+1
03800 MOVE 2,KK ;RW=R-RA*(K/36.)**R9
03900 MOVNS RA
04000 FDVR 2,[=36.0]
04100 MOVE 3,.COMM.+=10
04200 PUSHJ 17,EXP3.2 ; I HOPE!
04300 FMPR 2,RA
04400 MOVE RW,RA
04500 FADR RW,R
04600 MOVEI 1,INP ; SLURY(L)=RW
04700 ADDI 1,(L)
04800 MOVEM RW,(1)
04900 MOVE 2,[=73] ;40 SLURY(73-L)=RW
05000 SUBI 2,(L)
05100 MOVEI 1,INP
05200 ADDI 1,(2)
05300 MOVEM RW,(1)
05400 FSBR KK,[=1.0]
05500 JUMPG KK,SLR40
05600 MOVE L,[=72] ;L=72
05700
05800 MOVE 2,.COMM.+=20 ;89 IF(RTILT.EQ.0)GO TO 87
05900 JUMPE 2,SLR87 ;RETURNS
06000 JSA 16,ATAN2 ;RW=ATAN2(RTILT,RXX)
06100 JUMP .COMM.+=20
06200 JUMP .COMM.+=19
06300 MOVE RW,0
06400 JSA 16,SIN ;RA=SIN(RW)
06500 JUMP RW ; ????
06600 MOVE RA,0
06700 JSA 16,COS ;RB=COS(RW)
06800 JUMP RW
06900 MOVE RB,0
07000 MOVE RZ,SLR ;RZ=SLURX(1)
07100 MOVE RW,INP+1 ;RW=SLURY(1)
07200 MOVEI KK,SLR ;DO 83 K=1,L
07300 MOVEI 4,(L)
07400 ADD 4,KK ;ADR. OF SLURX(L+1)
07500 MOVEI SY,INP
07600 SLR83: MOVE R,-1(KK) ;R=SLURX(K)-RZ
07700 FSBR R,RZ
07800 MOVE RX,(SY) ;RXX=SLURY(K)-RW
07900 FSBR RX,RW
08000 MOVN 2,RA ;SLURX(K)=RB*R-RA*RXX+RZ
08100 FMPR 2,RX
08200 FADR 2,RZ
08300 MOVE 3,R
08400 FMPR 3,RB
08500 FADR 3,2
08600 MOVEM 3,-1(KK)
08700 MOVE 2,RA ;83 SLURY(K)=RB*RXX+RA*R+RW
08800 FMPR 2,R
08900 FADR 2,RW
09000 MOVE 3,RX
09100 FMPR 3,RB
09200 FADR 3,2
09300 MOVEM 3,(SY)
09400 AOJ SY
09500 CAIGE KK,(4)
09600 AOJA KK,SLR83
09700 JRA 16,(16)
09800 A: 0
09900 B: 0
10000 L: 0
10100
10200 RNOTE: 0 ; SUBROUTINE RNOTE(X)
10300 MOVE 2,@(16) ;COMMON /PTR/PWDS(250),ITEM,L,I,IX/XRN/RN(4000)
10400 JSA 16,AMOD ;X=RN(IFIX(PWDS(IFIX(AMOD(X,1000.))))+2)
10500 JUMP 2
10600 JUMP [=1000.0]
10700 MOVE 2,0
10800 FIXX(2)
10900 MOVEI 3,PTR
11000 ADDI 3,(2) ;END
11100 MOVE 3,-1(3)
11200 FIXX(3)
11300 MOVEI 2,XRN
11400 ADDI 2,(3)
11500 MOVE 3,-1(2)
11600 MOVEM 3,@(16)
11700 JSA 16,1(16)
11800
11900 DRWNT: 0 ; SUBROUTINE DRWNT(RMINI)
12000 MOVE 5,.COMM.+2 ;COMMON /STF/RSTFAC(-3/4),RSTJ2
12100 SETOM .COMM.+=29 ;COMMON R2,JA,CENTR,J2,RJQ(20),JQ(20)
12200 MOVE 7,.COMM.+=26;EQUIVALENCE (JE,JQ(3)),(RJD,RJQ(2)),(R6,RJQ(4)),
12300 MOVE 6,.COMM.+7 ;1(JG,JQ(5)),(R7,RJQ(5)),(RJE,RJQ(3)),(RJZ,RJQ(20))
12400 MOVE 10,.COMM.+=8 ;1 ,(JI,JQ(7)),(R9,RJQ(7)),(JH,JQ(6))
12500 MOVE 2,@(16) ;RJX=CENTR
12600 FMPR 2,[=0.5] ;JH=0
12700 ; JH=0 SO IT WILL FILL. (P8 IN 'CLEFS')
12800 FDVR 2,STF+=8 ;RA=R6
12900 MOVEM 2,.COMM.+7 ;R6=.5*RMINI/RSTJ2
13000 MOVEM 2,.COMM.+=8 ;R7=R6
13100 MOVE 2,.COMM.+=22 ;RJD=RJZ-3
13200 FSBR 2,[=3.0]
13300 MOVEM 2,.COMM.+5
13400 ; ADJUSTS POSITION FOR MINI ACCIDENTALS (..??!!)
13500 MOVE 11,.COMM.+=30
13600 SETZM .COMM.+=30 ;JI=0
13700 JSA 16,CLEFS ;CALL CLEFS
13800 MOVEM 11,.COMM.+=30 ;JI=R9 (I SAVED JI IN 11)
13900 ; ↑↑↑↑↑↑ NEEDED??
14000 ; FOR WHITE NOTES AND ACCIS ON PLOTTER.
14100 MOVEM 5,.COMM.+2 ;CENTR=RJX
14200 MOVEM 6,.COMM.+7 ;R6=RA
14300 MOVEM 7,.COMM.+=26 ;R7=JG
14400 MOVEM 10,.COMM.+=8 ;JE=RJE
14500 JRA 16,1(16) ;END (ALIGNMENT ABOVE IS OFF!)
14600
14700 RDRAW: 0 ; SUBROUTINE RDRAW(I,S,XY,X,R3,CENTR,RMINI)
14800 MOVEI 2,@2(16) ;C TO X,Y INTO ONE WORD
14900 ADD 2,@(16) ;DIMENSION XY(1)
15000 MOVE 3,@1(16) ;DO 2 K=I,IFIX(S)
15100 FIXX(3)
15200 MOVEI 10,@2(16)
15300 ADDI 10,(3)
15400 MOVEM 10,DRWNT ;SAVE IT FOR NOW
15500 RD2: MOVEI 4,2 ; L=2
15600 MOVE 5,-1(2) ; Y=XY(K)
15700 CAMGE 5,[=1000.0] ;IF(Y.LT.1000.)GO TO 3
15800 JRST RD3
15900 MOVEI 4,3 ;L=3
16000 FSBR 5,[=1000.0] ;Y=Y-1000.
16100 ; >1000 = INVIS. LINE
16200 RD3: MOVE 6,5 ;3 M=Y
16300 MOVEM 4,L
16400 FIXX(6) ; M
16500 MOVE 7,6 ;Y=(Y-M)*1000.
16600 TLC 7,232000
16700 FADR 7,7 ; FLOATS
16800 FSBR 5,7
16900 FMPR 5,[=1000.0] ; Y
17000 CAMG 5,[=100.0] ;IF(Y.GT.100.)Y=100-Y
17100 JRST RD4
17200 FSBR 5,[=100.0]
17300 MOVNS 5
17400 RD4: FMPR 5,@3(16)
17500 ; Y NUMBERS .GT.100 ARE NEG.
17600 FADR 5,@5(16) ;B=Y*X+CENTR
17700 CAIG 6,=60 ;IF(M.GT.60)M=100-M
17800 JRST RD5
17900 SUBI 6,=100
18000 MOVNS 6
18100 RD5: TLC 6,232000 ; A=M*RMINI+R3
18200 FADR 6,6
18300 FMPR 6,@6(16)
18400 FADR 6,@4(16)
18500 MOVEM 6,A
18600 MOVEM 5,B
18700 MOVEM 2,RNOTE ;SAVE IT FOR A SECOND
18800 JSA 16,LINES ;2 CALL LINES(A,B,L)
18900 JUMP A
19000 JUMP B
19100 JUMP L
19200 MOVE 2,RNOTE
19300 CAMGE 2,DRWNT
19400 AOJA 2,RD2
19500 JRA 16,7(16)
19600
19700 END